home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / graphics / texter5.zip / TEST.PAS < prev    next >
Pascal/Delphi Source File  |  1994-04-19  |  3KB  |  107 lines
  1. {$X+}
  2. {$R-}
  3. USES crt;
  4.  
  5. CONST VGA = $a000;  (* This sets the constant VGA to the segment of the
  6.                        VGA screen.                                      *)
  7.       XSize = 16;
  8.       YSize = 16;
  9.  
  10. TYPE
  11.         Letter = Array[1..xsize,1..ysize] of Byte;
  12.         Letters = Array[' '..']'] of Letter;
  13.  
  14. VAR Font : ^Letters;
  15.  
  16. {──────────────────────────────────────────────────────────────────────────}
  17. Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
  18. BEGIN
  19.   asm
  20.      mov        ax,0013h
  21.      int        10h
  22.   end;
  23. END;
  24.  
  25.  
  26. {──────────────────────────────────────────────────────────────────────────}
  27. Procedure SetText;  { This procedure returns you to text mode.  }
  28. BEGIN
  29.   asm
  30.      mov        ax,0003h
  31.      int        10h
  32.   end;
  33. END;
  34.  
  35. {──────────────────────────────────────────────────────────────────────────}
  36. Procedure Pal(ColorNo : Byte; R,G,B : Byte);
  37.   { This sets the Red, Green and Blue values of a certain color }
  38. Begin
  39.    Port[$3c8] := ColorNo;
  40.    Port[$3c9] := R;
  41.    Port[$3c9] := G;
  42.    Port[$3c9] := B;
  43. End;
  44.  
  45.  
  46. {──────────────────────────────────────────────────────────────────────────}
  47. Procedure PutPixel (X,Y : Integer; Col : Byte; Where : Word);
  48.    { This puts a pixel at X,Y using color col, on VGA or the Virtual Screen}
  49. BEGIN
  50.   Mem [Where:X+(Y*320)]:=col;
  51. END;
  52.  
  53. {──────────────────────────────────────────────────────────────────────────}
  54. procedure LoadPal (FileName : string);
  55.    { This loads the Pallette file and puts it on screen }
  56. type DACType = array [0..255] of record
  57.                                 R, G, B : byte;
  58.                               end;
  59. var DAC : DACType;
  60.     Fil : file of DACType;
  61.     I : integer;
  62. BEGIN
  63.   assign (Fil, FileName);
  64.   reset (Fil);
  65.   read (Fil, DAC);
  66.   close (Fil);
  67.   for I := 0 to 255 do Pal(I,Dac[I].R,Dac[I].G,Dac[I].B);
  68. end;
  69.  
  70.  
  71. {──────────────────────────────────────────────────────────────────────────}
  72. Procedure Init;
  73.   { This loads the font and the pallette }
  74. VAR f:file;
  75.     loop1:integer;
  76.  
  77. BEGIN
  78.   getmem (font,sizeof (font^));
  79.   Assign (f,'softrock.fnt');
  80.   reset (f,1);
  81.   blockread (f,font^,sizeof (font^));
  82.   close (f);
  83.   SetMCGA;
  84.   loadpal ('pallette.col');
  85. END;
  86.  
  87. {──────────────────────────────────────────────────────────────────────────}
  88. Procedure DrawText (X,Y:Integer;Msg:String);
  89.   { This draws MSG at the coords X,Y }
  90. VAR loop1,loop2,loop3:integer;
  91. BEGIN
  92.   For loop1:=1 to length (msg) do
  93.     For loop2:=1 to xsize do
  94.       For loop3:=1 to ysize do
  95.         PutPixel ((loop1*(xsize+1))+loop2+x,loop3+y,font^[msg[loop1],loop2,loop3],vga);
  96. END;
  97.  
  98. BEGIN
  99.   Init;
  100.   DrawText (10,10,'ASPHYXIA RULZ!!!');
  101.   DrawText (50,50,'BOB LIVES!');
  102.   DrawText (10,90,'REGISTER TEXTER!');
  103.   Readkey;
  104.   Settext;
  105.   freemem (font,sizeof (font^));
  106. END.
  107.